home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / PSC_FileSt1924438162005.psc / PSC FileStore / frmCompactDB.frm < prev    next >
Text File  |  2005-08-09  |  6KB  |  205 lines
  1. VERSION 5.00
  2. Begin VB.Form frmCompactDB 
  3.    Caption         =   "Compact and repair Database"
  4.    ClientHeight    =   7005
  5.    ClientLeft      =   165
  6.    ClientTop       =   555
  7.    ClientWidth     =   11145
  8.    LinkTopic       =   "Form1"
  9.    LockControls    =   -1  'True
  10.    ScaleHeight     =   7005
  11.    ScaleMode       =   0  'User
  12.    ScaleWidth      =   11145
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin VB.CommandButton cmdCompact 
  15.       Caption         =   "Compact"
  16.       BeginProperty Font 
  17.          Name            =   "MS Sans Serif"
  18.          Size            =   9.75
  19.          Charset         =   0
  20.          Weight          =   700
  21.          Underline       =   0   'False
  22.          Italic          =   0   'False
  23.          Strikethrough   =   0   'False
  24.       EndProperty
  25.       Height          =   375
  26.       Left            =   5569
  27.       TabIndex        =   4
  28.       Top             =   5500
  29.       Width           =   1500
  30.    End
  31.    Begin VB.CommandButton cmdMainMenu 
  32.       Caption         =   "Main menu"
  33.       BeginProperty Font 
  34.          Name            =   "MS Sans Serif"
  35.          Size            =   9.75
  36.          Charset         =   0
  37.          Weight          =   700
  38.          Underline       =   0   'False
  39.          Italic          =   0   'False
  40.          Strikethrough   =   0   'False
  41.       EndProperty
  42.       Height          =   375
  43.       Left            =   4076
  44.       TabIndex        =   0
  45.       ToolTipText     =   "Returns to Main Menu."
  46.       Top             =   5500
  47.       Width           =   1500
  48.    End
  49.    Begin VB.Label lblCompactDone 
  50.       Alignment       =   2  'Center
  51.       Caption         =   "Compacting and repair the Database has been done!"
  52.       BeginProperty Font 
  53.          Name            =   "MS Sans Serif"
  54.          Size            =   18
  55.          Charset         =   0
  56.          Weight          =   700
  57.          Underline       =   0   'False
  58.          Italic          =   0   'False
  59.          Strikethrough   =   0   'False
  60.       EndProperty
  61.       ForeColor       =   &H00FF0000&
  62.       Height          =   500
  63.       Left            =   135
  64.       TabIndex        =   5
  65.       Top             =   4080
  66.       Width           =   10875
  67.    End
  68.    Begin VB.Label Label1 
  69.       Alignment       =   2  'Center
  70.       Caption         =   "Compact and repair Database"
  71.       BeginProperty Font 
  72.          Name            =   "Arial Black"
  73.          Size            =   14.25
  74.          Charset         =   0
  75.          Weight          =   700
  76.          Underline       =   0   'False
  77.          Italic          =   0   'False
  78.          Strikethrough   =   0   'False
  79.       EndProperty
  80.       ForeColor       =   &H000000FF&
  81.       Height          =   375
  82.       Left            =   720
  83.       TabIndex        =   3
  84.       Top             =   480
  85.       Width           =   9735
  86.    End
  87.    Begin VB.Label Label2 
  88.       Caption         =   "Click the button to Compact and repair the Database."
  89.       BeginProperty Font 
  90.          Name            =   "MS Sans Serif"
  91.          Size            =   9.75
  92.          Charset         =   0
  93.          Weight          =   400
  94.          Underline       =   0   'False
  95.          Italic          =   0   'False
  96.          Strikethrough   =   0   'False
  97.       EndProperty
  98.       Height          =   252
  99.       Left            =   1572
  100.       TabIndex        =   2
  101.       Top             =   3216
  102.       Width           =   8000
  103.    End
  104.    Begin VB.Label Label3 
  105.       Caption         =   "If you are being doing a lot of deleting the Database will reduce is size."
  106.       BeginProperty Font 
  107.          Name            =   "MS Sans Serif"
  108.          Size            =   9.75
  109.          Charset         =   0
  110.          Weight          =   400
  111.          Underline       =   0   'False
  112.          Italic          =   0   'False
  113.          Strikethrough   =   0   'False
  114.       EndProperty
  115.       Height          =   252
  116.       Left            =   1572
  117.       TabIndex        =   1
  118.       Top             =   3536
  119.       Width           =   8000
  120.    End
  121. End
  122. Attribute VB_Name = "frmCompactDB"
  123. Attribute VB_GlobalNameSpace = False
  124. Attribute VB_Creatable = False
  125. Attribute VB_PredeclaredId = True
  126. Attribute VB_Exposed = False
  127. Option Explicit
  128.  
  129. Private Sub Call_DoGoneOut()
  130.  
  131.   'Saving to the register the size and position of form before leaving the form
  132.  
  133.     With Me
  134.         SaveSetting "PSC Soft", "PSC FileStore", "Height", .Height
  135.         SaveSetting "PSC Soft", "PSC FileStore", "Left", .Left
  136.         SaveSetting "PSC Soft", "PSC FileStore", "Top", .Top
  137.         SaveSetting "PSC Soft", "PSC FileStore", "Width", .Width
  138.     End With 'Me
  139.     Set frmCompactDB = Nothing
  140.  
  141. End Sub
  142.  
  143. Private Sub Call_ThisFormSize()
  144.  
  145.     With Me
  146.         glFormHeight = .Height
  147.         glFormLeft = .Left
  148.         glFormTop = .Top
  149.         glFormWidth = .Width
  150.     End With 'ME
  151.  
  152. End Sub
  153.  
  154. Private Sub cmdCompact_Click()
  155.  
  156.   Dim FSys As New FileSystemObject
  157.  
  158.     Screen.MousePointer = vbHourglass
  159.     DB1.Close
  160.     Set DB1 = Nothing
  161.     Name App.Path & "\PSCFileStore.mdb" As App.Path & "\PSCFileStoreOld.mdb"
  162.     DBEngine.CompactDatabase App.Path & "\PSCFileStoreOld.mdb", App.Path & "\PSCFileStore.mdb"
  163.     If FSys.FileExists(App.Path & "\PSCFileStoreOld.mdb") Then
  164.         FSys.DeleteFile (App.Path & "\PSCFileStoreOld.mdb")
  165.     End If
  166.     Set DB1 = OpenDatabase(App.Path & "\PSCFileStore.mdb", False, False, ";pwd=")
  167.     lblCompactDone.Caption = "Compacting and repair the Database has been done!"
  168.     cmdCompact.Enabled = False
  169.     Screen.MousePointer = vbDefault
  170.  
  171. End Sub
  172.  
  173. Private Sub cmdMainMenu_Click()
  174.  
  175.     Call_ThisFormSize
  176.     frmStartMenu.Show
  177.     Unload Me
  178.  
  179. End Sub
  180.  
  181. Private Sub Form_Load()
  182.  
  183.     gsLocalForm = Me.Caption
  184.     Me.Caption = gsProgName & " - " & Me.Caption & " - " & gsOwner
  185.     With Me
  186.         .Height = glFormHeight
  187.         .Left = glFormLeft
  188.         .Top = glFormTop
  189.         .Width = glFormWidth
  190.     End With 'ME
  191.     lblCompactDone.Caption = vbNullString
  192.  
  193. End Sub
  194.  
  195. Private Sub Form_Unload(Cancel As Integer)
  196.  
  197.     Call_DoGoneOut
  198.  
  199. End Sub
  200.  
  201. ':)Code Fixer V3.0.9 (04/08/2005 18:02:36) 1 + 76 = 77 Lines Thanks Ulli for inspiration and lots of code.
  202.  
  203. ':) Ulli's VB Code Formatter V2.17.9 (2005-Aug-09 21:50)  Decl: 1  Code: 77  Total: 78 Lines
  204. ':) CommentOnly: 2 (2.6%)  Commented: 3 (3.8%)  Empty: 21 (26.9%)  Max Logic Depth: 2
  205.